home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / SystemCode / grep.tcl < prev    next >
Text File  |  1996-08-15  |  4KB  |  137 lines
  1. #================================================================================
  2. # 'greplist' and 'grepfset' are used for batch searching from the "find" dialog.
  3. #  Hence, you really shouldn't mess with them unless you know what you are doing.
  4. #================================================================================
  5. proc greplist {args} {
  6.     global tileLeft tileTop tileWidth tileHeight errorHeight
  7.  
  8.     set recurse [car $args]
  9.     set word [cadr $args]
  10.     set args [cddr $args]
  11.     
  12.     set num [expr [llength $args] - 2]
  13.     set exp [lindex $args $num]
  14.     set arglist [lindex $args [expr $num + 1]]
  15.     
  16.     set opened 0
  17.     set owin 0
  18.     set cid [scancontext create]
  19.  
  20.     set cmd [lrange $args 0 [expr $num - 1]]
  21.     eval scanmatch $cmd {$cid $exp {
  22.         if {!$word || [regexp -nocase "(^|¥[^a-zA-Z0-9¥])${exp}(¥[^a-zA-Z0-9¥]|¥$)" $matchInfo(line)]} {
  23.             if (!$owin) {
  24.                 set owin 1
  25.                 new -n {* Batch Find *} -g $tileLeft $tileTop $tileWidth $errorHeight
  26.  
  27.                 global winModes
  28.                 set name [lindex [winNames] 0]
  29.                 changeMode [set winModes($name) Brws]
  30.  
  31.                 insertText "(<cr> to go to match)¥r-----¥r"
  32.                 set w [car [winNames -f]]
  33.                 set opened 1
  34.             }
  35.             set l [expr 20 - [string length [file tail $f]]]
  36.             insertText -w $w "¥"[file tail $f]¥"[format "%$l¥s" ""]; Line $matchInfo(linenum): $matchInfo(line)¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥tｰ$f¥r"}
  37.         }
  38.     }
  39.  
  40.     foreach f $arglist {
  41.         message [file tail $f]
  42.         if {![catch {set fid [open $f]}]} {
  43.             scanfile $cid $fid
  44.             close $fid
  45.         }
  46.     }
  47.     scancontext delete $cid
  48.  
  49.     if {$opened} {
  50.         select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  51.         setWinInfo dirty 0
  52.         setWinInfo read-only 1
  53.     }
  54.     message ""
  55. }
  56.  
  57. proc grepfset {args} {
  58.     set num [expr [llength $args] - 2]
  59.     set exp [lindex $args $num]
  60.     set fset [lindex $args [expr $num + 1]]
  61.     eval greplist 0 [lrange $args 0 [expr $num-1]] {$exp [getFileSet $fset]}
  62. }
  63.  
  64. proc grep {exp args} {
  65.     set files {}
  66.     foreach arg $args {
  67.         if {![catch {glob -t TEXT $arg} lst]} {
  68.             append files " " $lst
  69.         }
  70. #         if {![catch {glob -t ttro $arg} lst]} {
  71. #             append files " " $lst
  72. #         }
  73.     }
  74.     if {$files==""} {return $lst}
  75.     set cid [scancontext create]
  76.     scanmatch $cid $exp {
  77.         if {!$blah} {
  78.             set blah 1
  79.             set lines "(<cr> to go to match)¥r"
  80.         }
  81.         set l [expr 20 - [string length [file tail $f]]]
  82.         append lines "¥"[file tail $f]¥"[format "%$l¥s" ""]; Line $matchInfo(linenum): $matchInfo(line)¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥tｰ$f¥r"
  83.     }
  84.  
  85.     set blah 0
  86.     set lines ""
  87.  
  88.     foreach f $files {
  89.         if {![catch {set fid [open $f]}]} {
  90.             message [file tail $f]
  91.             scanfile $cid $fid
  92.             close $fid
  93.         }
  94.     }
  95.     scancontext delete $cid
  96.     return [string trimright $lines "¥r"]
  97. }
  98.  
  99.  
  100. #===============================================================================
  101.  
  102. set lastMatchingLines ""
  103.  
  104. proc matchingLines {{reg ""} {for 1} {ign 1} {word 0} {regexp 1}} {
  105.     global lastMatchingLines tileLeft tileTop tileWidth errorHeight
  106.     
  107.     if {![string length $reg] && [catch {prompt "Regular expression:" $lastMatchingLines} reg]} return
  108.     set lastMatchingLines $reg
  109.     if {![string length $reg]} return
  110.     if {!$regexp} {
  111.         set reg [quoteExpr2 $reg]
  112.         regsub -all {¥¥¥¥} $reg {¥¥} reg
  113.     }
  114.     set reg ^.*$reg.*$
  115.     set pos [expr $for ? 0 : [getPos]]
  116.     set fileName [car [winNames -f]]
  117.     set matches 0
  118.     while {![catch {search -s -f 1 -r 1 -m $word -i $ign $reg $pos} mtch]} {
  119.         append lines "¥r" [format "Line %d: " [lindex [posToRowCol [lindex $mtch 0]] 0]] [eval getText $mtch] "¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥tｰ$fileName"
  120.         set pos [lindex $mtch 1]
  121.         incr matches
  122.     }
  123.     new -n {* Matching Lines *} -g $tileLeft $tileTop $tileWidth $errorHeight
  124.     insertText [format "%d matching lines (<cr> to go to match)¥r-----" $matches] $lines "¥r"
  125.     select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  126.     
  127.     global winModes
  128.     set name [lindex [winNames] 0]
  129.     changeMode [set winModes($name) Brws]
  130.     setWinInfo dirty 0
  131.     setWinInfo read-only 1
  132. }
  133.  
  134. proc findBatch {forward ignore regexp word pat} {
  135.     matchingLines $pat $forward $ignore $word $regexp 
  136. }
  137.